home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / win / stampr11.zip / STAMP_LG.PAS < prev    next >
Pascal/Delphi Source File  |  1995-01-01  |  6KB  |  216 lines
  1. {****    Stamper 1.0 Copyright 1994 Hemal Popat ********}
  2. program Stamper;
  3. {$R Stamper.RES}
  4. uses WinTypes,WinProcs,Objects,OWindows,ODialogs,Strings,WinDos,CommDlg,Win31;
  5. const
  6.     ST_Name     = 'Stamper';
  7.     id_About    = 501;
  8.     id_CMGetFiles    = 601;
  9.     id_CMALTER    = 602;
  10.     id_CMExit    = 610;
  11.     id_edit        = 603;
  12.     tctrl=699;
  13. {**********************    TYPES    ******************************}
  14. type
  15.     TSTApp = object(TApplication)
  16.     procedure InitMainWindow; virtual;
  17. end;
  18.  
  19. PSTWindow = ^TSTWindow;
  20. TSTWindow = object(TWindow)
  21.     About,Select,Alter,BtExit:PButton;
  22.     Text:PStatic;
  23.     EditBox:PEdit;
  24.     FilesBuf:PChar;
  25.     CurTime:LongInt;
  26.     constructor Init(ATitle: PChar);
  27.     destructor Done; virtual;
  28.     procedure SetupWindow;virtual;
  29.     procedure IDAbout (Var Msg:TMessage);virtual id_first+id_about;
  30.     procedure IDCMALTER(Var Msg:TMessage);virtual id_First+id_CMALTER;
  31.     procedure IDCMExit(Var Msg:TMessage);virtual id_First+id_CMExit;
  32.     procedure IDCMGetFiles(Var Msg:TMessage);virtual id_First+id_CMGetFiles;
  33. end;
  34. {*********************    Functions    *******************************}
  35. function StrTok(P:PChar;C:Char):PChar;
  36. const
  37.     Next:Pchar = nil;
  38. begin
  39.     if P = NIL then P := Next;
  40.     if P <> NIL then begin
  41.         Next := StrScan(P,C);
  42.         If Next <> NIL then begin
  43.             Next^ := #0;
  44.             Next := Next+1;
  45.             end;
  46.         end;
  47.     StrTok := P;
  48. end;
  49. {**********************    METHODS    ******************************}
  50. procedure TSTApp.InitMainWindow;
  51. begin
  52.     MainWindow := New(PSTWindow, Init(ST_Name));
  53. end;
  54. {**********************    TSTWindow    *******************************}
  55. constructor TSTWindow.Init(ATitle: PChar);
  56. var
  57.     Indx:Integer;
  58. begin
  59.     TWindow.Init(nil, ATitle);
  60. with Attr do
  61.     begin
  62.         X := 50; Y := 50; W := 285; H := 220;
  63.         Attr.Style := ws_Overlapped or ws_SysMenu or ws_MinimizeBox;
  64.         end;
  65.     About:=New(PButton,Init(@Self,id_about,'&About',150,150,120,40,false));
  66.     Alter:=New(PButton,Init(@Self,id_CMAlter,'Al&ter',15,150,120,40,false));
  67.     BtExit:=New(PButton,Init(@Self,id_CMExit,'E&xit',150,100,120,40,false));
  68.     Select:=New(PButton,Init(@Self,id_CMGetFiles,'&Select',15,100,120,40,true));
  69.     EditBox:=New(PEdit,Init(@Self,id_edit,'950101000000',80,59,120,28,13,false));
  70.     Text:=New(PStatic,Init(@Self,071,' Enter Date/Time in format:',30,5,215,20,30));
  71.     Text:=New(PStatic,Init(@Self,071,' yymmddhhmmss',70,32,140,20,30));
  72.     GetMem(FilesBuf,4096);
  73.     StrCopy(FilesBuf,'');
  74. end;
  75.  
  76. destructor TSTWindow.Done;
  77. begin
  78.     FreeMem(FilesBuf,4096);
  79.     TWindow.Done;
  80. end;
  81.  
  82. procedure TSTWindow.SetupWindow;
  83. var
  84.     SysMenu:HMenu;
  85. begin
  86.     TWindow.SetupWindow;
  87.     SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'ST_Icon'));
  88.     SetClassWord(HWindow,GCW_HBrBackground,GetStockObject(ltGray_Brush));
  89.     end;
  90.  
  91. procedure TSTWindow.IDCMGetFiles(var Msg:TMessage);
  92. const
  93.     szFilter:Array[0..8] of Char ='*.*'#0'*.*'#0#0;
  94. var
  95.     Path,Name,Ext,OldDir:Array[0..fsPathName] of Char;
  96.     szDirName:Array[0..256] of Char;
  97.     szFile,szFileTitle:Array[0..512] of Char;
  98.     OFN:TOpenFileName;
  99.     P:PChar;
  100. begin
  101.     StrCopy(FilesBuf,'');
  102.     OFN.lStructSize := sizeof(TOpenFileName);
  103.     OFN.hWndOwner := HWindow;
  104.     OFN.lpStrFilter := @szFilter;
  105.     OFN.lpStrCustomFilter := nil;
  106.     OFN.nMaxCustFilter := 0;
  107.     OFN.nFilterIndex := LongInt(1);
  108.     OFN.lpStrFile := FilesBuf;
  109.     OFN.nMaxFile := 4096;
  110.     OFN.lpstrfileTitle := szFileTitle;
  111.     OFN.nMaxFileTitle := sizeof(szFileTitle);
  112.     OFN.lpstrInitialDir := NIL;
  113.     OFN.lpStrTitle := 'Select Files';
  114.     OFN.flags := OFN_ALLOWMULTISELECT;
  115.     OFN.nFileOffset := 0;
  116.     OFN.nFileExtension := 0;
  117.     OFN.lpstrDefext := nil;
  118.     GetOpenFileName(OFN)
  119. end;
  120.  
  121. procedure TSTWindow.IDCMALTER(var Msg:TMessage);
  122. var
  123.     Path,PathName:Array[0..69] of Char;
  124.     FName:Array[0..18] of Char;
  125.     pResult:PChar;
  126.     Files:PStrCollection;
  127.     Indx:Integer;
  128.     Instring:array[0..12] of Char;
  129.     inputpas:string;
  130.     code:integer;
  131.     error:boolean;
  132.     DT:TDateTime;
  133.     time:longint;
  134.     F:File;
  135. begin
  136.     if StrLen(FilesBuf) = 0 then    {0 files selected - error message}
  137.         begin
  138.         MessageBeep(mb_IconExclamation);
  139.         MessageBox(HWindow,'Please select files first','Stamper',mb_IconExclamation);
  140.         Exit;
  141.         end;
  142.     EditBox^.GetText(Instring,13);
  143.     inputpas:=StrPas(instring);
  144.     error:=false;
  145.     with DT do begin
  146.         val(copy(inputpas,1,2),year,code);
  147.         if code<>0 then error:=true;
  148.         val(copy(inputpas,3,2),month,code);
  149.         if code<>0 then error:=true;
  150.         val(copy(inputpas,5,2),day,code);
  151.         if code<>0 then error:=true;
  152.         val(copy(inputpas,7,2),hour,code);
  153.         if code<>0 then error:=true;
  154.         val(copy(inputpas,9,2),min,code);
  155.         if code<>0 then error:=true;
  156.         val(copy(inputpas,11,2),sec,code);
  157.         if code<>0 then error:=true;
  158.     end;
  159.     if error=true then
  160.         begin
  161.         MessageBeep(mb_IconExclamation);
  162.         MessageBox (HWindow,'Please enter date/time correctly','Stamper',mb_iconexclamation);
  163.         Exit;
  164.         end;
  165.     DT.year:=DT.year+1900;
  166.     PackTime(DT,Time);
  167.     Files := New(PStrCollection,Init(10,10));
  168.     pResult := StrScan(FilesBuf,' ');
  169.     if pResult = NIL then    {1 file only}
  170.         Files^.Insert(StrNew(FilesBuf))
  171.         else begin    {2 or more}
  172.         pResult := StrTok(FilesBuf,' ');    {get the path}
  173.         StrCopy(Path,pResult);
  174.         SetCurDir(Path);        {chdir there}
  175.         pResult := StrTok(NIL,' ');    {get the 1st filename}
  176.         while pResult <> NIL do begin
  177.             FileExpand(PathName,pResult);    {expand file name}
  178.             Files^.Insert(StrNew(PathName));    {store it in collection}
  179.             pResult := StrTok(NIL,' ');    {get next file name}
  180.             end;
  181.         end;
  182.     for Indx := 0 to (Files^.Count -1) do begin    {process the selected files}
  183.         pResult := Files^.At(Indx);
  184.         Assign(F,PResult);
  185.         Reset(F);
  186.         SetFTime(F,Time);
  187.         Close(F);
  188.         end;
  189.     Dispose(Files,Done);    {clean up collection}
  190.     sendmessage(hwnd_broadcast,wm_user+$0206,0,0); {update file manager window}
  191. end;
  192.  
  193. procedure TSTWindow.IDCMExit(var Msg:TMessage);
  194. begin
  195.     CloseWindow;
  196. end;
  197.  
  198. procedure TSTWindow.IDAbout(var Msg:TMessage);
  199. begin
  200.     case Msg.Wparam of
  201.         id_About:
  202.             application^.ExecDialog(New(PDialog,Init(@Self,'ST_About')));
  203.     else
  204.         DefWndProc(Msg);
  205.     end;
  206. end;
  207.  
  208. {**********************    MainLine    *******************************}
  209. var
  210.     STApp: TSTApp;
  211. begin
  212.     STApp.Init(ST_Name);
  213.     STApp.Run;
  214.     STApp.Done;
  215. end.
  216.